home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / stv.lha / STV / ISA / carolina / blockpro.prj next >
Text File  |  1993-07-23  |  12KB  |  451 lines
  1. "
  2. ******************************************************************************
  3. Project : Blockpro
  4. Date    : Jan 21, 1990
  5. Time    : 17:48:07
  6.  
  7. Introduction
  8. ============
  9.  
  10. PROLOG/V: PROLOG IN THE SMALLTALK ENVIRONMENT_
  11. by
  12. Gregory L. Lazarev
  13.  
  14.  
  15.  
  16. Invoked By:
  17. ===========
  18.  
  19. BlockPro new openOn
  20.  
  21.  
  22.  
  23. Description
  24. ===========
  25.  
  26. Classes : 
  27.     BlocksPro Blocks 
  28.  
  29. Methods : 
  30.  
  31. ******************************************************************************
  32. "!
  33.  
  34. "Initialize"
  35.  
  36. "To start evaluate the following "
  37. " BlocksPro example1  "
  38. "Then select the example you wish to try"
  39. "Then click on the Right button"
  40. "Choose "do" on the pop up menu"
  41. !
  42.  
  43. Planner variableSubclass: #Blocks
  44.   instanceVariableNames: 
  45.     'position animator number between replyStream selectedChoice '
  46.   classVariableNames: ''
  47.   poolDictionaries: ''!
  48.  
  49. Blocks variableSubclass: #BlocksPro
  50.   instanceVariableNames: ''
  51.   classVariableNames: ''
  52.   poolDictionaries: ''!
  53.  
  54.  
  55. !BlocksPro class methods !
  56.  
  57. example1
  58. " BlocksPro example1 "
  59. BlocksPro new openOn! !
  60.  
  61.  
  62. !BlocksPro methods !
  63.  
  64. "add on the Block"
  65. addDraw(x,z) :- name( x,name1), name(z, name2),
  66.         is(_,self add: name1 value onBlock: name2 value).
  67.     "add on the Table"
  68. addDraw(x) :- name( x,name1), col( x, col1),
  69.         is(_,self add: name1 value onTable: col1 value).!
  70.  
  71. "arrange0 the first part of arrange"
  72. arrange0( len, _, _, accum, accum) :-
  73.     length( accum, accumLen),
  74.     eq( len, accumLen).
  75. arrange0( len,master,prev, accum, ordered) :-
  76.     nextStep( master, prev, [], nextPrev),
  77.     append( nextPrev, accum, nextAccum),
  78.     arrange0( len, master, nextPrev, nextAccum, ordered).!
  79.  
  80. "arrange1 the second part of arrange"
  81. arrange1( master, [#t], arrMaster, arrMaster).
  82. arrange1( master, [h|t], interm, arrMaster):-
  83.     member( on(h,x), master),
  84.     arrange1( master, t, [on(h,x) | interm], arrMaster).!
  85.  
  86. "arrange i.e. [on(a,b),on(b,t),on(c,t),on(d,a)] -->
  87.    [d,a,b,c,t] --> [on(c,t),on(b,t),on(a,b),on(d,a)"
  88. arrange( master, arrMaster) :-
  89.     length( master, len0),
  90.     is( len, len0 value + 1),
  91.     arrange0( len, master, [#t], [#t], ordered),
  92.     arrange1( master, ordered, [], arrMaster),
  93.    !!.!
  94.  
  95. " problem specific "
  96. blocks1() :- go( [on(#a,#b), on(#b,#t), on(#c,#t)],
  97.                  [on(#a,#b), on(#b,#c), on(#c,#t)]).!
  98.  
  99. " problem specific "
  100. blocks2() :- go( [on(#a,#t), on(#b,#t), on(#c,#a)],[on(#a,#b), on(#b,#c), on(#c,#t)]).!
  101.  
  102. " problem specific "
  103. blocks3() :- go( [on(#a,#b), on(#b,#t), on(#c,#t), on(#d,#a)],
  104.                 [on(#a,#d), on(#b,#c), on(#c,#t), on(#d,#b)]).!
  105.  
  106. clear( x,state) :- not( member( on(_,x), state)).!
  107.  
  108. "column locations"
  109. col( #a,1).
  110. col( #b,2).
  111. col( #c,3).
  112. col( #d,4).!
  113.  
  114. "go"
  115. go( start, goal) :-
  116.                     init( start),
  117.                     path( start, goal, [start]),
  118.                     is(_,self finish),
  119.                     !!.!
  120.  
  121. "initialize"
  122. init( start) :- length( start, startSize),
  123.                 is(_,self assign: startSize value),
  124.                 is(_, self initialize1),
  125.                 arrange( start, arrStart),
  126.                 initDraw( arrStart),
  127.                 is(_,Menu message: 'Press button to start'),
  128.                   !!.!
  129.  
  130. "initial drawing"
  131. initDraw([]).
  132. initDraw( [on(x,#t)| tail]) :- addDraw(x),
  133.                         initDraw(tail).
  134. initDraw( [on(x,z) | tail]) :- addDraw(x,z),
  135.                         initDraw(tail).!
  136.  
  137. "move"
  138. move( state1, state2,x,y,#t) :-
  139.     member( on( x,y), state1),
  140.     clear(x, state1),
  141.     not( table(y)),
  142.     subst( on( x,y), state1, on(x,#t), state2).
  143. move(state1,state2,x,y,z) :- member( on( x, y), state1),
  144.                        clear( x, state1),
  145.                        member( on( z, _), state1),  ne( x, z),
  146.                        clear( z, state1),
  147.                        subst( on( x, y), state1, on( x, z), state2).!
  148.  
  149. "draw block --> table"
  150. moveDraw( x,_,#t) :-
  151.     name(x, name1), col(x, col1),
  152.     is(_,self remove: name1 value),
  153.     is(_,self add: name1 value onTable: col1 value).
  154. "draw block --> block"
  155. moveDraw( x,_,z) :-
  156.     ne(z,#t),
  157.     name(x, name1), name(z,name2),
  158.     is(_ , self remove: name1 value),
  159.     is(_ , self add: name1 value onBlock: name2 value).!
  160.  
  161. "draw In and Out"
  162. moveDrawInOut(block, placeFrom, placeTo) :-
  163.     moveDraw(block, placeFrom, placeTo).
  164. moveDrawInOut(block, placeFrom, placeTo) :-
  165.     moveDraw(block, placeTo, placeFrom),
  166.     fail().  "reverse back"!
  167.  
  168. name( #a, 'Black').
  169. name( #b, 'LightGray').
  170. name( #c, 'Gray').
  171. name( #d, 'DarkGray').!
  172.  
  173. "nextStep called from arrange0"
  174. nextStep(_,[],nextPrev,nextPrev).
  175. nextStep(master,[h|t],current,nextPrev) :-
  176.     findall( x,member( on(x,h),master), interm),
  177.     append( interm, current, current1),
  178.     nextStep(master,t,current1,nextPrev).!
  179.  
  180. "path"
  181. path( goal, goal, hist) :- is(_, self changed: #reply),
  182.                         printpath( hist).
  183. path( state, goal, hist) :-
  184.     move( state, interm, block, placeFrom, placeTo ),
  185.     not (member( interm, hist)),
  186.     moveDrawInOut( block, placeFrom, placeTo),
  187.     path( interm, goal, [interm| hist]).!
  188.  
  189. "printpath1 called from printpath"
  190. printpath1([h]) :- is(_,replyStream nextPutAll:
  191.                 (h value printString) ).
  192. printpath1( [h|t]) :-  is(_,replyStream nextPutAll:
  193.                 ((h value printString),',') ),
  194.                 printpath1(t).!
  195.  
  196. "printpath print list in reverse order"
  197. printpath([]).
  198. printpath([h|t]) :- printpath(t),
  199.             is(_,replyStream nextPutAll: '['),
  200.             printpath1(h),
  201.             is(_,replyStream nextPutAll: ']'),
  202.             is(_,replyStream cr).!
  203.  
  204. "substitute"
  205. subst(_,[],_,[]).
  206. subst(x,[x|l],a,[a|m]) :- !!,
  207.                 subst(x,l,a,m).
  208. subst(x,[y|l],a,[y|m]) :- subst(x,l,a,m).!
  209.  
  210. table( #t).! !
  211.  
  212.  
  213. !Blocks class methods !
  214.  
  215. example1
  216. " Blocks example1 "
  217. | block selectedChoice|
  218. block :=  Blocks new.
  219. selectedChoice := #blocks1.
  220. block doBlocks.
  221. block inspect.! !
  222.  
  223.  
  224. !Blocks methods !
  225.  
  226. add: block1 onBlock: block2
  227. "add one block on top of block2"
  228. |ordColl index col size|
  229. index := 1.
  230. col := 0.
  231. [index <= number
  232.     and: [col = 0] ]
  233.     whileTrue: [
  234.         ((position at: index) includes: block2)
  235.         ifTrue: [col:=index].
  236.     index := index+1].
  237. ordColl := position at: col.
  238. ordColl add: block1.
  239. size := ordColl size.
  240. position at: col
  241.         put: ordColl.
  242. animator tell: block1
  243.         place: ((between * col) - (between * 2/3)) @
  244.                 ((RectPict extent y - 5) - (60 * size * Aspect) truncated).!
  245.  
  246. add: block onTable: col
  247. "reinitialize colunm add first block to it"
  248. |ordColl|
  249. ordColl := position at: col.
  250. ordColl add: block.
  251. position at: col
  252.         put: ordColl.
  253. animator tell: block
  254.     place: ((between * col)-(between * 2/3)) @
  255.            ((RectPict extent y - 5) - (60*Aspect)truncated)!
  256.  
  257. assign: size
  258. "assign a variable number"
  259. number := size!
  260.  
  261. choice: aSymbol
  262. "Private change to the selected choise type"
  263. selectedChoice := aSymbol. "blocks1,block2,block3"
  264. self changed: #input;
  265.      changed: #reply;
  266.      changed: #graph:!
  267.  
  268. choices
  269. "Private answer an array of choices"
  270. ^#( blocks1 blocks2 blocks3 )!
  271.  
  272. doBlocks
  273. "actual call to Prolog methods"
  274. CursorManager execute change.
  275. selectedChoice == #blocks1
  276.     ifTrue:[self :? blocks1()].
  277. selectedChoice == #blocks2
  278.     ifTrue:[self :? blocks2()].
  279. selectedChoice == #blocks3
  280.     ifTrue:[self :? blocks3()].
  281. CursorManager normal change!
  282.  
  283. doBlocksMenu
  284. ^Menu
  285.     labels: 'do\help\inspect\stop' withCrs
  286.     lines: #()
  287.     selectors: #(doBlocks help inspect stop)!
  288.  
  289. finish
  290.     Menu message: 'The solution is found'!
  291.  
  292. graph: aRect
  293. "initialize graph pane assign global variables"
  294. | aForm |
  295. aForm := Form width: aRect width height: aRect height.
  296. aForm displayAt: aRect origin.
  297. RectPict := aRect.
  298. White := (Form width: 60
  299.     height: (60 * Aspect) truncated ).
  300. ^aForm!
  301.  
  302. help
  303. "provide help messages"
  304. selectedChoice == #blocks1
  305.     ifTrue:[replyStream nextPutAll:
  306. 'EXPLANATION: This is an animation of the 3 block problem'; cr ].
  307. selectedChoice == #blocks2
  308.     ifTrue:[replyStream nextPutAll:
  309. 'EXPLANATION: This is an animation of the 3 block problem'; cr ].
  310. selectedChoice == #blocks3
  311.     ifTrue:[replyStream nextPutAll:
  312. 'EXPLANATION: This is an animation of the 4 block problem'; cr ].!
  313.  
  314. initAnimation
  315. "initialize Animation"
  316. | blockImages |
  317. blockImages := Array with: White.
  318. animator := Animation new
  319.     initialize: RectPict.
  320. animator add: blockImages
  321.     name: 'Black'
  322.     color: #black.
  323. animator add: blockImages
  324.     name: 'LightGray'
  325.     color: #lightGray.
  326. animator add: blockImages
  327.     name: 'Gray'
  328.     color: #gray.
  329. selectedChoice == #blocks3
  330.     ifTrue:[animator add: blockImages
  331.     name: 'DarkGray'
  332.     color: #darkGray].
  333. animator setBackground;
  334.     speed: 8;
  335.     shiftRate: 10.!
  336.  
  337. initialize1
  338. "initialize blocks"
  339. | pen |
  340. "draw bottom"
  341. pen := Pen new.
  342. pen defaultNib: 3@2.
  343. pen place:(RectPict origin x + 5) @ (RectPict corner y - 5);
  344.     goto: (RectPict corner x - 5) @ (RectPict corner y - 5).
  345. between := RectPict width // number.
  346. "initialize animation and position"
  347. self initAnimation;
  348.      initPosition!
  349.  
  350. initPosition
  351. "Set the receiver's initial position"
  352. position := Array new: number.
  353. 1 to: number do:[:index |  position at: index
  354.                             put: OrderedCollection new]!
  355.  
  356. input
  357. "Private answer the input text for the selectedChoice"
  358. | text1 text2 text3 text|
  359. text1 := 'FROM: A on B, B on Table, C on Table
  360. TO:  A on B, B on C, C on Table
  361.      (COLORS A-Black B-LightGray C-Gray)'.
  362. text2 := 'FROM: A on Table, B on Table, C on A
  363. TO:  A on B, B on C, C on Table
  364.      (COLORS A-Black B-LightGray C-Gray)'.
  365. text3 := 'FROM: A on B, B on Table, C on Table, D on A
  366. TO:  A on D, B on C, C on Table, D on B
  367.      (COLORS A-Black B-LightGray C-Gray D-DarkGray)'.
  368. selectedChoice == #blocks1
  369.     ifTrue: [text := text1].
  370. selectedChoice == #blocks2
  371.     ifTrue: [text := text2].
  372. selectedChoice == #blocks3
  373.     ifTrue: [text := text3].
  374. ^text!
  375.  
  376. openOn
  377. "Create a window on Blocks
  378. Define the type, behavior and relative size of
  379. each pane and schedule the window"
  380. | topPane replyPane |
  381. topPane := TopPane new label: ' B L O C K S'.
  382. topPane addSubpane:
  383.     (ListPane new
  384.         model: self;
  385.         name: #choices;
  386.         change: #choice:;
  387.         selection: 1;
  388.         framingRatio: (0@0 extent: 1/4 @ (1/6))).
  389. selectedChoice := #blocks1.
  390. topPane addSubpane:
  391.     (TextPane new
  392.         model: self;
  393.         name: #input;
  394.         menu: #doBlocksMenu;
  395.         framingRatio: (1/4 @ 0 extent: 3/4 @(1/6))).
  396. topPane addSubpane:
  397.     (replyPane := TextPane new
  398.         model: self;
  399.         name: #reply;
  400.         framingRatio: (0@ (1/6) extent: 1 @ (1/6))).
  401. topPane addSubpane:
  402.     (GraphPane new
  403.         model: self;
  404.         name: #graph:;
  405.         framingRatio:( 0 @ (1/3) extent: 1 @ (2/3))).
  406. topPane reframe:
  407.     (Display boundingBox insetBy: 10@10).
  408. replyStream := replyPane dispatcher.
  409. topPane dispatcher openWindow scheduleWindow!
  410.  
  411. remove: block
  412. "remove block from data structure"
  413. | ordColl index col |
  414. index := 1.
  415. col := 0.
  416. [index <= number & (col = 0)]
  417.     whileTrue: [((position at: index) includes: block)
  418.     ifTrue: [col := index].
  419.     index := index + 1].
  420. ordColl := position at: col.
  421. ordColl removeLast.
  422. position at: col put: ordColl.!
  423.  
  424. reply
  425. "initiate reply pane with an empty string"
  426. ^String new.!
  427.  
  428. stop
  429. "generate a self halt"
  430. self halt.! !
  431.  
  432. "construct application" 
  433. ((Smalltalk at: #Application ifAbsent: []) 
  434.     isKindOf: Class) ifTrue: [ 
  435.         ((Smalltalk at: #Application) for:'Blockpro')
  436.             addClass: BlocksPro;
  437.             addClass: Blocks;
  438.             comments: 'PROLOG/V: PROLOG IN THE SMALLTALK ENVIRONMENT_
  439. by
  440. Gregory L. Lazarev
  441. ';
  442.             initCode: '"To start evaluate the following "
  443. " BlocksPro example1  "
  444. "Then select the example you wish to try"
  445. "Then click on the Right button"
  446. "Choose "do" on the pop up menu"
  447. ';
  448.             finalizeCode: nil;
  449.             startUpCode: 'BlockPro new openOn
  450. ']!
  451.